perm filename CB.OLD[DRW,LCS] blob sn#449476 filedate 1979-06-10 generic text, type T, neo UTF8
00100		SUBROUTINE CMBN
00200		COMMON /RC/MCLEF(400),IST(4000)
00300		COMMON /FL/NX,N,L,M,NM,J,NT
00400		DIMENSION IP(10),NMS(10),NF(2500),JP(10),NMX(10)
00500		EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
00600		1,(JP,IST(1500)),(NMX,IST(1510))
00700	C *****   ******   ****   ******              ↑ 20 FOR OVERRUN IN IP(11) AT 119
00800	C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  400 WD LIMIT PER FILE.
00900		IF(N.EQ.'S')GO TO 103
01000	102	TYPE 1
01100	1	FORMAT(' TYPE OUTPUT FILE NAME ',$)
01200	10	FORMAT(A5)
01300		DO 122 K=1,10
01400		IP(K)=0
01500	122	NMS(K)=' '
01600		ACCEPT 10,NM
01700		IF(NM.NE.' ')GO TO 40
01800		NM=LASTNM
01900		TYPE 107,LASTNM
02000	40	LASTNM=NM
02100		IF(LOOKF(NM).EQ.0)GO TO 100
02200		IF(N.NE.'C')GO TO 103
02300	C  FOR ADDING TO COMBINED FILE.
02400		TYPE 101,NM
02500		ACCEPT 10,NX
02600		IF(NX.EQ.'N')GO TO 102
02700	100	IF(N.EQ.'C')GO TO 104
02800		TYPE 52
02900		GO TO 102
03000	104	L=0
03100		NX=1
03200		I=0
03300	30	L=L+1
03400		TYPE 41
03500	41	FORMAT(' TYPE FILE NAME ',$)
03600		ACCEPT 10,NW
03700		IF(NW.EQ.' ')GO TO 8
03800		IF(LOOKF(NW))GO TO 51
03900		TYPE 52
04000		GO TO 30
04100	52	FORMAT(' FILE NOT FOUND'/)
04200	51	I=I+1
04300		IP(L)=NX
04400		NMS(I)=NW
04500		CALL RDSAV(JP,NMX,K,NW,MCLEF(NX),-2)
04600		NX=NX+K
04700		IF(L.LT.10)GO TO 30
04800	101	FORMAT(' WRITE OVER ',A5,'.DMD?  Y OR N?  ',$)
04900	8	NX=NX-1
05000	14	CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
05100		L=NX
05200		RETURN
05300	
05400	1103	TYPE 1104,ID
05500	1104	FORMAT(' FILE FULL -- SAVED AS ',A5)
05600		L=1
05700		NM=ID
05800		NX=MCLEF(1)
05900		GO TO 8
06000	
06100	103	CALL RDSAV(IP,NMS,NX,NM,NF,-1)
06200	107	FORMAT(1X,A5)
06300		TYPE 109
06400	109	FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
06500		ACCEPT 10,ID
06600		IF(ID.EQ.' ')GO TO 102
06700		JD=0
06800		L=0
06900	CC	NX=NX-1
07000		DO 110 K=1,10
07100		IF(NMS(K).EQ.ID)JD=K
07200		IF(NMS(K).EQ.' ')GO TO 112
07300		L=K
07400	110	IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
07500	112	IF(N.EQ.'Z')GO TO 127
07600	C  FOR DELETIONS
07700		L=L+1
07800		IF(JD.NE.0)GO TO 111
07900	C ADDS ON TO END
08000		N=0
08100		IP(L)=NX+1
08200		DO 113 K=NX+1,MCLEF(1)+NX
08300		N=N+1
08400	113	NF(K)=MCLEF(N)
08500		NX=NX+N
08600		NMS(L)=ID
08700		L=L+1
08800	114	DO 115 K=1,NX
08900	115	MCLEF(K)=NF(K)
09000	C MOVES IT ALL TO MCLEF
09100		GO TO 14
09200	
09300	127	MCLEF(1)=0
09400	111	N=IP(JD)
09500		NR=MCLEF(1)
09600		M=NF(IP(JD))
09700		NW=NR-M
09800		NX=NX+NW
09900		IF(NW)201,120,203
10000	201	JA=N+NR
10100		JB=NX
10200		JC=1
10300		GO TO 204
10400	203	JA=NX
10500		JB=N+NW
10600		JC=-1
10700	204	DO 121 K=JA,JB,JC
10800	121	NF(K)=NF(K-NW)
10900		IF(NR.EQ.0)GO TO 126
11000	120	DO 117 K=1,NR
11100		NF(N)=MCLEF(K)
11200	117	N=N+1 
11300	CC	L=L-1
11400		IF(NW.EQ.0)GO TO 114
11500		DO 119 K=JD+1,L
11600	119	IP(K)=IP(K)+NW
11700	C  FIXES UP FIRST LINE.
11800	CC123	L=L-1
11900	CC	NX=NX-1
12000		GO TO 114
12100	126	IP(L+1)=0
12200	CC	L=L-1
12300		DO 124 K=JD,L-1
12400		IP(K)=IP(K+1)+NW
12500	124	NMS(K)=NMS(K+1)
12600		NMS(L)=' '
12700		GO TO 114
12800		END
12900	
13000		SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
13100	C  POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
13200		COMMON /RC/MCLEF(400),IST(4000)/FL/IC,NH,NQ,A,B,C,D
13300		DIMENSION KT(1),NMS(1),IO(1),JALL(21)
13400		IF(L)GO TO 5
13500	C  L=-1  FOR READER, -2=NO TYPE OF NAME LIST.
13600		DO 1 N=1,10
13700		JALL(N)=KT(N)
13800	1	JALL(N+11)=NMS(N)
13900		JALL(11)=K
13950		TYPE 6,K
14000		CALL PUTFIL(NAME)
14100		CALL FASTOU(JALL,21)
14200		CALL FASTOU(IO,K+1)
14300		CALL FINFIL
14400		RETURN
14500	
14600	5	CALL GETFIL(NAME)
14700		CALL FASTIN(JALL,21)
14800		K=JALL(11)
14820		TYPE 6,K
14840	6	FORMAT(' TOTAL WDS=',I3,'/350')
14900		CALL FASTIN(IO,K)
15000		DO 2 N=1,10
15100		KT(N)=JALL(N)
15200	2	NMS(N)=JALL(N+11)
15300		IF(L.EQ.-2)RETURN
15400		TYPE 3
15500		TYPE 4,(NMS(N),N=1,10)
15600	3	FORMAT(
15700		1'  0      1      2      3      4      5      6      7
15800		1      8      9')
15900	4	FORMAT(' IDENT. NAMES:'/,10(2XA5))
16000		END
16100	
16200		SUBROUTINE CNVT
16300		COMMON/RC/A(4400)
16400		DIMENSION J(10),NM(10),M(600),JALL(21)
16500		EQUIVALENCE(J,JALL,A),(NX,JALL(11)),(NM,JALL(12)),(M,A(2000))
16600	C  POINTER LIST, TOTAL WD CNT, NAME LIST.
16700		TYPE 1
16800	1	FORMAT(' TYPE OLD NAME --  '$)
16900		ACCEPT 2,N
17000	2	FORMAT(A5)
17100		TYPE 3
17200	3	FORMAT(' NEW NAME --  '$)
17300		ACCEPT 2,NN
17400		CALL IFILE(1,N)
17500		NX=1
17600		READ(1,4)K,J
17700	4	FORMAT(12I)
17800	6	READ(1,4,END=5)K,K,(M(L),L=NX,NX+K-1)
17900		REREAD 7,L,NM
18000		IF(NM(1))GO TO 5
18100		NX=NX+K
18200		GO TO 6
18300	7	FORMAT(I,10A5)
18400	
18500	5	NX=NX-1
18600		CALL RDSAV(J,NM,NX,NN,M,0)
18700	C  POINTERS, NAMES, WDCNT, FILE NAME, ARRAY, 0=WRITE
18800		CALL EXIT
18900		END